home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue26 / construc / DRBOBDOS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-06-17  |  2.7 KB  |  108 lines
  1. unit DrBobDOS;
  2. { (c) 1997 by Bob Swart (aka Dr.Bob - www.drbob42.com) }
  3. interface
  4. uses
  5.   SysUtils, WinTypes, WinProcs, Classes;
  6.  
  7. type
  8.   TBDosEnvironment = class(TComponent)
  9.   public
  10.   { Public class declarations (override) }
  11.     constructor Create(AOwner: TComponent); override;
  12.     destructor Destroy; override;
  13.  
  14.   private
  15.   { Private field declarations }
  16.     FDosEnvList: TStringList;
  17.     procedure DoNothing(const Value: TStringList);
  18.  
  19.   protected
  20.   { Protected method declarations }
  21.     Dummy: Word;
  22.     function GetDosEnvCount: Word;
  23.  
  24.   public
  25.   { Public interface declarations }
  26.     function GetDosEnvStr(const Name: String): String;
  27.     { This function is a modified version of the GetEnvVar function that
  28.       appears in the WinDos unit that comes with Delphi. This function's
  29.       interface uses Pascal strings instead of null-terminated strings.
  30.     }
  31.  
  32.   published
  33.   { Published design declarations }
  34.     property DosEnvCount: Word read GetDosEnvCount write Dummy;
  35.     property DosEnvList: TStringList read FDosEnvList write DoNothing;
  36.   end;
  37.  
  38. implementation
  39.  
  40.   constructor TBDosEnvironment.Create(AOwner: TComponent);
  41.   var
  42.     P: PChar;
  43.   begin
  44.     inherited Create(AOwner);
  45.     FDosEnvList := TStringList.Create;
  46.   {$IFDEF WIN32}
  47.     P := GetEnvironmentStrings;
  48.   {$ELSE}
  49.     P := GetDosEnvironment;
  50.   {$ENDIF}
  51.     while P^ <> #0 do
  52.     begin
  53.       FDosEnvList.Add(StrPas(P));
  54.       Inc(P, StrLen(P)+1) { Fast Jump to Next Var }
  55.     end;
  56.   end {Create};
  57.  
  58.   destructor TBDosEnvironment.Destroy;
  59.   begin
  60.     FDosEnvList.Free;
  61.     FDosEnvList := nil;
  62.     inherited Destroy
  63.   end {Destroy};
  64.  
  65.   procedure TBDosEnvironment.DoNothing(const Value: TStringList);
  66.   begin
  67.   end {DoNothing};
  68.  
  69.  
  70.   function TBDosEnvironment.GetDosEnvCount: Word;
  71.   { Returns the number of environment variables.
  72.   }
  73.   begin
  74.     if Assigned(FDosEnvList) then
  75.       Result := FDosEnvList.Count
  76.     else
  77.       Result := 0;
  78.   end {GetDosEnvCount};
  79.  
  80.   function TBDosEnvironment.GetDosEnvStr(const Name: String): String;
  81.   { This function is a modified version of the GetEnvVar function that
  82.     appears in the WinDos unit that comes with Delphi. This function's
  83.     interface uses Pascal strings instead of null-terminated strings.
  84.   }
  85.   var
  86.     i: Integer;
  87.     Tmp: String;
  88.   begin
  89.     i := 0;
  90.     Result := '';
  91.     if Assigned(FDosEnvList) then while i < FDosEnvList.Count do
  92.     begin
  93.       Tmp := FDosEnvList[i];
  94.       Inc(i);
  95.       if Pos(Name,Tmp) = 1 then
  96.       begin
  97.         Delete(Tmp,1,Length(Name));
  98.         if Tmp[1] = '=' then
  99.         begin
  100.           Delete(Tmp,1,1);
  101.           Result := Tmp;
  102.           i := FDosEnvList.Count { end while-loop }
  103.         end
  104.       end
  105.     end
  106.   end {GetDosEnvStr};
  107. end.
  108.